home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / demosrc / cfsource / part2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-29  |  31.4 KB  |  1,339 lines
  1. {$R-,S-}
  2. PROGRAM HardwareZoom;
  3. USES
  4.     Crt,MCGA,Tools;
  5. CONST
  6.      TextStr:String='STEFAN OHRHALLINGER PRESENTS:   YET ANOTHER ROUNDSCROLLER ...                   ';
  7. TYPE
  8.     LineType=ARRAY[0..3,0..79] OF Byte;
  9.     PalType=ARRAY[0..255,1..3] OF Byte;
  10. VAR
  11.    FontCh:ARRAY[0..255] OF ^ByteArray;
  12.    TextData:ARRAY[0..63,0..15] OF Char;
  13.    Factor,Size,Dir,X,Y,I,J,K,Phase,XCountCurr,LastCos,CurrCos:Integer;
  14.    ColorTab,GapTab:ARRAY[0..399] OF Byte;
  15.    StartMap,EndMap,R,G,B,PalSel:Byte;
  16.    XCount,YCount,SizeX,DirX,PhaseX:ARRAY[0..3] OF Integer;
  17.    LineData:ARRAY[0..255] OF ^LineType;
  18.    DisplayStart:ARRAY[0..799] OF ShortInt;
  19.    Spr,BallLightSpr,EarthMapSpr:Pointer;
  20.    Adr,Shade:Word;
  21.    OfsTable:ARRAY[34..199,0..199] OF Byte;
  22.    Pal:ARRAY[0..255,1..3] OF Byte;
  23.    Line640:ARRAY[0..319] OF Byte;
  24.    Palette:PalType;
  25.    F:File;
  26.    SpherePal:ARRAY[0..63] OF ^PalType;
  27.    LightTable:ARRAY[0..255] OF Byte;
  28.    SphereMap:ARRAY[0..15,0..15] OF Word;
  29.    EarthFrame:ARRAY[0..255] OF Byte;
  30.    ArcSinTable:ARRAY[-255..255] OF Real;
  31.    SinTab,CosTab:ARRAY[0..255] OF Integer;
  32.    XLATTable:ARRAY[0..63] OF Byte;
  33.  
  34. PROCEDURE LoadFontMCF(FontName:String);
  35. VAR
  36.    FontFile:File;
  37.    I:Byte;
  38.    L:LongInt;
  39.    X,Y:Integer;
  40.    Size:Word;
  41. BEGIN
  42.      Assign(FontFile,FontName+'.MCF');
  43.      Reset(FontFile,1);
  44.      FOR I:=0 TO 255 DO
  45.      BEGIN
  46.           FontCh[I]:=NIL;
  47.           BlockRead(FontFile,L,4);
  48.           X:=Integer(L);
  49.           Y:=L SHR 16;
  50.           Size:=(X+1)*(Y+1);
  51.           IF X*Y>0 THEN
  52.           BEGIN
  53.                GetAdjMem(Pointer(FontCh[I]),Size+4);
  54.                FontCh[I]^[0]:=Lo(X);
  55.                FontCh[I]^[1]:=Hi(X);
  56.                FontCh[I]^[2]:=Lo(Y);
  57.                FontCh[I]^[3]:=Hi(Y);
  58.                BlockRead(FontFile,FontCh[I]^[4],Size);
  59.           END;
  60.      END;
  61. END;
  62.  
  63. PROCEDURE Set16Pal(Nr:Byte);
  64. VAR
  65.    I:Byte;
  66. BEGIN
  67.      I:=Port[$3DA];
  68.      Port[$3C0]:=$34;
  69.      Port[$3C0]:=Nr;
  70. END;
  71.  
  72. PROCEDURE Init16Pal;
  73. VAR
  74.    I:Byte;
  75. BEGIN
  76.      I:=Port[$3DA];
  77.      FOR I:=0 TO 15 DO
  78.      BEGIN
  79.           Port[$3C0]:=I;
  80.           Port[$3C0]:=I;
  81.      END;
  82.      Port[$3C0]:=$10;
  83.      Port[$3C0]:=$81;
  84.      Set16Pal(0);
  85. END;
  86.  
  87. PROCEDURE CalcBall;
  88. VAR
  89.    I,J,X,Y:Integer;
  90.    C:Byte;
  91. BEGIN
  92.      FOR J:=0 TO 15 DO
  93.          FOR I:=0 TO 15 DO
  94.          BEGIN
  95.               X:=I-16;
  96.               Y:=J-16;
  97.               IF Sqr(X)+Sqr(Y)<Sqr(16) THEN
  98.                  C:=16-Round(Sqrt(Sqr(X)+Sqr(Y)))
  99.               ELSE C:=0;
  100.               IF C>15 THEN
  101.                  C:=15;
  102.               SetColor(J SHL 4+I,C SHL 2,C SHL 2,C SHL 2);
  103.          END;
  104. END;
  105.  
  106. PROCEDURE CalcLines;
  107. VAR
  108.    I,J,K:Integer;
  109.    B,Map:Byte;
  110.    LineX:LineType;
  111. BEGIN
  112.      FOR J:=16 TO 254 DO
  113.          IF NOT Odd(J) THEN
  114.          BEGIN
  115.               New(LineData[J]);
  116.               ASM
  117.                  push ds
  118.                  pop es
  119.                  mov di,offset line640
  120.                  xor bx,bx
  121.                  mov dx,j
  122.                  shl dx,1
  123.                  mov cx,640
  124.                  cld
  125.     @1:          mov ax,bx
  126.                  shr ax,8
  127.                  and al,31
  128.                  cmp al,16
  129.                  jl @2
  130.                  neg al
  131.                  add al,31
  132.     @2:          stosb
  133.                  add bx,dx
  134.                  loop @1
  135.               END;
  136.               FOR K:=0 TO 3 DO
  137.               BEGIN
  138.                    Map:=1 SHL K;
  139.                    FOR I:=0 TO 79 DO
  140.                    BEGIN
  141.                         ASM
  142.                            mov si,i
  143.                            shl si,3
  144.                            add si,offset line640
  145.                            mov bl,map
  146.                            cld
  147. @1:                        mov bh,0
  148.                            lodsw
  149.                            and al,bl
  150.                            jnz @2
  151.                            or bh,128
  152. @2:                        and ah,bl
  153.                            jnz @3
  154.                            or bh,64
  155. @3:                        lodsw
  156.                            and al,bl
  157.                            jnz @4
  158.                            or bh,32
  159. @4:                        and ah,bl
  160.                            jnz @5
  161.                            or bh,16
  162. @5:                        lodsw
  163.                            and al,bl
  164.                            jnz @6
  165.                            or bh,8
  166. @6:                        and ah,bl
  167.                            jnz @7
  168.                            or bh,4
  169. @7:                        lodsw
  170.                            and al,bl
  171.                            jnz @8
  172.                            or bh,2
  173. @8:                        and ah,bl
  174.                            jnz @9
  175.                            or bh,1
  176. @9:                        mov b,bh
  177.                         END;
  178.                         LineX[K,I]:=B;
  179.                    END;
  180.               END;
  181.               LineData[J]^:=LineX;
  182.          END;
  183. END;
  184.  
  185. PROCEDURE PutLine(Nr:Integer);
  186. VAR
  187.    I,J:Integer;
  188. BEGIN
  189.      ASM
  190.         push ds
  191.         mov ax,0a000h
  192.         mov es,ax
  193.         mov bx,nr
  194.         shl bx,2
  195.         add bx,offset linedata
  196.         lds si,[bx]
  197.         cld
  198.         mov ax,0102h
  199. @1:     mov dx,03c4h
  200.         out dx,ax
  201.         xor di,di
  202.         mov cx,20
  203.         db 66h
  204.         rep movsw
  205.         shl ah,1
  206.         cmp ah,10h
  207.         jnz @1
  208.         pop ds
  209.      END;
  210. END;
  211.  
  212. PROCEDURE DrawFrame;
  213. BEGIN
  214.      ASM
  215.         mov cx,400
  216.         mov bx,y
  217.  
  218. @1:     mov dx,03c0h
  219.         mov al,34h
  220.         out dx,al
  221.         mov al,bh
  222.         and al,31
  223.         cmp al,16
  224.         jl @1a
  225.         neg al
  226.         add al,31
  227. @1a:    out dx,al
  228.         add bx,factor
  229.  
  230.         mov dx,03dah
  231. @2:     in al,dx
  232.         test al,1
  233.         jnz @2
  234. @3:     in al,dx
  235.         test al,1
  236.         jz @3
  237.         loop @1
  238.      END;
  239. END;
  240.  
  241. {
  242. PROCEDURE CalcBall2;
  243. VAR
  244.    I,J,X,Y:Integer;
  245.    C:Byte;
  246. BEGIN
  247.      FOR J:=0 TO 15 DO
  248.          FOR I:=0 TO 15 DO
  249.          BEGIN
  250.               X:=I-8;
  251.               Y:=J-8;
  252.               IF Sqr(X)+Sqr(Y)<Sqr(9) THEN
  253.                  C:=9-Round(Sqrt(Sqr(X)+Sqr(Y)))
  254.               ELSE C:=0;
  255.               IF C>7 THEN
  256.                  C:=7;
  257.               SetColor(J SHL 4+I,C SHL 3,C SHL 3,C SHL 3);
  258.          END;
  259. END;
  260. }
  261.  
  262. PROCEDURE CalcLines2;
  263. VAR
  264.    I,J,K,L,X,XInc:Integer;
  265.    Map:Byte;
  266.    LineX:LineType;
  267. BEGIN
  268.      FOR J:=16 TO 127 DO
  269.      BEGIN
  270.           New(LineData[J]);
  271.           ASM
  272.              push ds
  273.              pop es
  274.              mov di,offset line640
  275.              xor bx,bx
  276.              mov dx,j
  277.              shl dx,1
  278.              mov cx,640
  279.              cld
  280. @1:          mov ax,bx
  281.              shr ax,8
  282.              and al,15
  283.              stosb
  284.              add bx,dx
  285.              loop @1
  286.           END;
  287.               FOR K:=0 TO 3 DO
  288.               BEGIN
  289.                    Map:=1 SHL K;
  290.                    FOR I:=0 TO 79 DO
  291.                    BEGIN
  292.                         ASM
  293.                            mov si,i
  294.                            shl si,3
  295.                            add si,offset line640
  296.                            mov bl,map
  297.                            cld
  298. @1:                        mov bh,0
  299.                            lodsw
  300.                            and al,bl
  301.                            jnz @2
  302.                            or bh,128
  303. @2:                        and ah,bl
  304.                            jnz @3
  305.                            or bh,64
  306. @3:                        lodsw
  307.                            and al,bl
  308.                            jnz @4
  309.                            or bh,32
  310. @4:                        and ah,bl
  311.                            jnz @5
  312.                            or bh,16
  313. @5:                        lodsw
  314.                            and al,bl
  315.                            jnz @6
  316.                            or bh,8
  317. @6:                        and ah,bl
  318.                            jnz @7
  319.                            or bh,4
  320. @7:                        lodsw
  321.                            and al,bl
  322.                            jnz @8
  323.                            or bh,2
  324. @8:                        and ah,bl
  325.                            jnz @9
  326.                            or bh,1
  327. @9:                        mov b,bh
  328.                         END;
  329.                         LineX[K,I]:=B;
  330.                    END;
  331.               END;
  332.               LineData[J]^:=LineX;
  333.      END;
  334. END;
  335.  
  336. {
  337. PROCEDURE DrawFrame2;
  338. BEGIN
  339.      ASM
  340.         mov cx,256
  341.         mov bx,y
  342.         les di,spherepal
  343.         mov di,phase
  344.         neg di
  345.         and di,127
  346.         shl di,8
  347.         mov dx,03c8h
  348.         mov al,0
  349.         out dx,al
  350.         cld
  351.  
  352. @1:     mov al,es:[di]
  353.         inc di
  354.         mov ah,0
  355.         mov si,ax
  356.         shl si,1
  357.         add si,ax
  358.         add si,offset palette
  359.  
  360.         mov dx,03dah
  361. @2:     in al,dx
  362.         test al,1
  363.         jz @2
  364.  
  365.         mov dx,03c9h
  366.         outsb
  367.         outsb
  368.         outsb
  369.  
  370.         mov dx,03c0h
  371.         mov al,34h
  372.         out dx,al
  373.         mov al,bh
  374.         out dx,al
  375.         add bx,factor
  376.  
  377.         mov dx,03dah
  378. @3:     in al,dx
  379.         test al,1
  380.         jnz @3
  381.         loop @1
  382.  
  383.         mov cx,144
  384.         mov di,03dah
  385.         mov dx,03c0h
  386.  
  387. @4:     mov al,34h
  388.         out dx,al
  389.         mov al,bh
  390.         and al,15
  391.         out dx,al
  392.         add bx,factor
  393.  
  394.         xchg dx,di
  395. @5:     in al,dx
  396.         test al,1
  397.         jnz @5
  398. @6:     in al,dx
  399.         test al,1
  400.         jz @6
  401.         xchg dx,di
  402.         loop @4
  403.      END;
  404. END;
  405. }
  406.  
  407. PROCEDURE DrawFrame2;
  408. BEGIN
  409.      ASM
  410.         mov cx,256
  411.         mov bx,y
  412.         mov dx,03c8h
  413.         mov al,0
  414.         out dx,al
  415.         mov di,factor
  416.         cld
  417.         push ds
  418.         mov si,phase
  419.         shr si,1
  420.         and si,63
  421.         shl si,2
  422.         lds si,[si+offset spherepal]
  423.         mov dx,03dah
  424.  
  425. @1:     in al,dx
  426.         test al,1
  427.         jz @1
  428.  
  429.         mov dx,03c9h
  430.         outsb
  431.         outsb
  432.         outsb
  433.  
  434.         mov dx,03c0h
  435.         mov al,34h
  436.         out dx,al
  437.         mov al,bh
  438.         out dx,al
  439.         add bx,di
  440.  
  441.         mov dx,03dah
  442. @2:     in al,dx
  443.         test al,1
  444.         jnz @2
  445.         loop @1
  446.         pop ds
  447.  
  448.         mov cx,144
  449.         mov di,03dah
  450.         mov dx,03c0h
  451.  
  452. @4:     mov al,34h
  453.         out dx,al
  454.         mov al,bh
  455.         and al,15
  456.         out dx,al
  457.         add bx,factor
  458.  
  459.         xchg dx,di
  460. @5:     in al,dx
  461.         test al,1
  462.         jnz @5
  463. @6:     in al,dx
  464.         test al,1
  465.         jz @6
  466.         xchg dx,di
  467.         loop @4
  468.      END;
  469. END;
  470.  
  471. FUNCTION ArcSin(X:Real):Real;
  472. BEGIN
  473.      ArcSin:=ArcTan(X/Sqrt(1-Sqr(X)))
  474. END;
  475.  
  476. PROCEDURE CalcEarth;
  477. VAR
  478.    X,Y,X2,Y2,YSqr,YSqrt:Real;
  479. BEGIN
  480.      FOR I:=-255 TO 255 DO
  481.          ArcSinTable[I]:=ArcSin(I/256)/Pi*2;
  482.      FOR J:=0 TO 15 DO
  483.      BEGIN
  484.           Y:=J-8;
  485.           Y2:=ArcSinTable[Round(255*Y/8)];
  486.           YSqrt:=Sqrt(1-Sqr(Y/8))*8;
  487.           YSqr:=Sqr(Y);
  488.           FOR I:=0 TO 15 DO
  489.           BEGIN
  490.                X:=I-8;
  491.                IF Sqr(X)+YSqr<64 THEN
  492.                BEGIN
  493.                     X2:=ArcSinTable[Round(255*X/YSqrt)];
  494.                     SphereMap[J,I]:=(10+Round(Y2*15)) SHL 6+16+Round(X2*15)
  495.                END
  496.                ELSE SphereMap[J,I]:=0;
  497.           END;
  498.           WriteLn(J);
  499.      END;
  500. END;
  501.  
  502. PROCEDURE DrawEarth(Phase:Integer);
  503. VAR
  504.    I,J:Integer;
  505. BEGIN
  506.      FOR J:=0 TO 15 DO
  507.          FOR I:=0 TO 15 DO
  508.          BEGIN
  509.               ASM
  510.                  mov ax,ds
  511.                  mov es,ax
  512.                  mov di,offset earthframe
  513.                  mov ax,j
  514.                  shl ax,4
  515.                  add di,ax
  516.                  add di,i
  517.                  mov si,j
  518.                  shl si,4
  519.                  add si,i
  520.                  shl si,1
  521.                  add si,offset spheremap
  522.                  cld
  523.                  lodsw
  524.                  or ax,ax
  525.                  jz @1
  526.                  push ds
  527.                  lds si,earthmapspr
  528.                  mov si,phase
  529.                  add si,ax
  530.                  add si,4
  531.                  movsb
  532.                  pop ds
  533.                  jmp @2
  534. @1:              mov al,0
  535.                  stosb
  536. @2:           END;
  537.          END;
  538. END;
  539.  
  540. PROCEDURE CalcOfsTable;
  541. VAR
  542.    I,J,CurrY,OldY,K:Integer;
  543. BEGIN
  544.      FOR J:=34 TO 199 DO
  545.      BEGIN
  546.           OldY:=199;
  547.           FOR I:=199 DOWNTO 0 DO
  548.               IF I>J THEN
  549.                  OfsTable[J,I]:=0
  550.               ELSE
  551.               BEGIN
  552.                    CurrY:=Round(I/J*199);
  553.                    OfsTable[J,I]:=40*(OldY-CurrY);
  554.                    OldY:=CurrY;
  555.               END;
  556.      END;
  557. END;
  558.  
  559. PROCEDURE ShowPicture;
  560. BEGIN
  561.      ASM
  562.         mov bx,i
  563.         sub bx,34
  564.         mov ax,397
  565.         mul bx
  566.         mov bx,ax
  567.  
  568.         mov di,offset xlattable
  569.         push ds
  570.         pop es
  571.         mov cx,64
  572.         cld
  573. @0:     mov al,64
  574.         sub al,cl
  575.         mov ah,0
  576.         mul bx
  577.         mov al,dl
  578.         stosb
  579.         loop @0
  580.  
  581.         mov dx,03c8h
  582.         mov al,0
  583.         out dx,al
  584.         inc dx
  585.         mov si,offset pal
  586.         add si,767
  587.         mov cx,256
  588.         mov bx,offset xlattable
  589.         std
  590. @1:     lodsb
  591.         xlat
  592.         push ax
  593.         lodsb
  594.         xlat
  595.         push ax
  596.         lodsb
  597.         xlat
  598.         push ax
  599.         loop @1
  600.      END;
  601.      WaitScreen;
  602.      ASM
  603.         mov si,offset ofstable
  604.         mov ax,i
  605.         sub ax,34
  606.         mov bx,200
  607.         mul bx
  608.         add si,ax
  609.         add si,199
  610.         mov cx,200
  611.         std
  612.  
  613.         mov dx,$3da
  614. @1:     in al,dx
  615.         test al,1
  616.         jnz @1
  617.  
  618. @2:     lodsb
  619.         mov ah,al
  620.         mov al,13h
  621.         mov dx,03d4h
  622.         out dx,ax
  623.  
  624.         mov dx,03c9h
  625.         pop ax
  626.         out dx,al
  627.         pop ax
  628.         out dx,al
  629.         pop ax
  630.         out dx,al
  631.  
  632.         mov dx,$3da
  633. @3:     in al,dx
  634.         test al,1
  635.         jz @3
  636.  
  637.         loop @1
  638.      END;
  639.      ASM
  640.         inc si
  641.         cld
  642.         mov cx,200
  643.  
  644. @1:     mov dx,$3da
  645.         in al,dx
  646.         test al,1
  647.         jnz @1
  648.  
  649. @2:     lodsb
  650.         mov ah,al
  651.         mov al,13h
  652.         mov dx,$3d4
  653.         out dx,ax
  654.  
  655.         cmp cx,144
  656.         jle @4
  657.         mov dx,03c9h
  658.         pop ax
  659.         out dx,al
  660.         pop ax
  661.         out dx,al
  662.         pop ax
  663.         out dx,al
  664.  
  665. @4:     mov dx,$3da
  666. @5:     in al,dx
  667.         test al,1
  668.         jz @5
  669.  
  670.         loop @1
  671.      END;
  672.      WaitRetrace;
  673. END;
  674.  
  675. BEGIN
  676.  
  677.      { Big Zoom of Ball, 32x32 }
  678.  
  679.      FOR I:=0 TO 255 DO
  680.      BEGIN
  681.           SinTab[I]:=Round(64*Sin(I/64*Pi));
  682.           CosTab[I]:=Round(200*Cos(I/64*Pi));
  683.      END;
  684.      SetModeNr($0D);
  685.      Init16Pal;
  686.      CalcBall;
  687.      CalcLines;
  688.      SetOffset(0);
  689.      Factor:=16;
  690.      Dir:=2;
  691.      Phase:=0;
  692.      REPEAT
  693.            CLI;
  694.            IF Phase AND 511<118 THEN
  695.               Factor:=16+Byte(Phase) SHL 1
  696.            ELSE
  697.            IF Phase AND 511<256 THEN
  698.               Factor:=250
  699.            ELSE
  700.            IF Phase AND 511<374 THEN
  701.               Factor:=250-(Phase AND 127) SHL 1
  702.            ELSE Factor:=16;
  703.            PutLine(Factor);
  704.            X:=SinTab[Byte(Phase)]+64;
  705.            SetHorizOfs(X AND 3);
  706.            SetStart(X SHR 2);
  707.            Y:=CosTab[Byte(Phase)];
  708.            Y:=Y*Factor;
  709.            SetOffset(0);
  710.            WaitScreen;
  711.            DrawFrame;
  712.            WaitRetrace;
  713.            SetOffset(40);
  714.            Inc(Factor,Dir);
  715.            IF (Factor=16) OR (Factor=250) THEN
  716.               Dir:=-Dir;
  717.            Inc(Phase);
  718.            STI;
  719.      UNTIL (Phase=1280) OR KeyPressed;
  720.      IF KeyPressed THEN
  721.         WaitKey;
  722.  
  723.      { Animated Zoom, 16x16 }
  724.  
  725.      FOR I:=0 TO 255 DO
  726.      BEGIN
  727.           SinTab[I]:=Round(64*Sin(I/64*Pi));
  728.           CosTab[I]:=Round(200*Cos(I/64*Pi));
  729.      END;
  730.      CalcEarth;
  731.      Assign(F,'EARTH.MAP');
  732.      Reset(F,1);
  733.      BlockRead(F,Palette,768);
  734.      GetAdjMem(EarthMapSpr,1344);
  735.      BlockRead(F,EarthMapSpr^,1344);
  736.      Close(F);
  737.      Assign(F,'BALLIGHT.SPR');
  738.      Reset(F,1);
  739.      Seek(F,4);
  740.      BlockRead(F,LightTable,256);
  741.      Close(F);
  742.      FOR I:=0 TO 63 DO
  743.      BEGIN
  744.           DrawEarth(I);
  745.           GetAdjMem(Pointer(SpherePal[I]),768);
  746.           FOR J:=0 TO 255 DO
  747.           BEGIN
  748.                SpherePal[I]^[J,1]:=(Palette[EarthFrame[J],1]*LightTable[J]) SHR 8;
  749.                SpherePal[I]^[J,2]:=(Palette[EarthFrame[J],2]*LightTable[J]) SHR 8;
  750.                SpherePal[I]^[J,3]:=(Palette[EarthFrame[J],3]*LightTable[J]) SHR 8;
  751.           END;
  752.      END;
  753.      CalcLines2;
  754.      SetOffset(0);
  755.      Factor:=16;
  756.      Dir:=1;
  757.      Phase:=0;
  758.      SetOffset(0);
  759.      REPEAT
  760.            CLI;
  761.            IF Phase AND 511<111 THEN
  762.               Factor:=126-Phase AND 127
  763.            ELSE
  764.            IF Phase AND 511<256 THEN
  765.               Factor:=16
  766.            ELSE
  767.            IF Phase AND 511<367 THEN
  768.               Factor:=16+Phase AND 127
  769.            ELSE Factor:=126;
  770.            PutLine(Factor);
  771.            X:=SinTab[Byte(Phase)]+64;
  772.            SetHorizOfs(X AND 3);
  773.            SetStart(X SHR 2);
  774.            Y:=CosTab[Byte(Phase)];
  775.            Y:=Y*Factor;
  776.            WaitScreen;
  777.            DrawFrame2;
  778.            WaitRetrace;
  779.            Inc(Phase);
  780.            STI;
  781.      UNTIL (Phase=1536) OR KeyPressed;
  782.      IF KeyPressed THEN
  783.         WaitKey;
  784.  
  785.      { Checkers }
  786.  
  787.      SetStart(0);
  788.      SetHorizOfs(0);
  789.      FOR I:=0 TO 255 DO
  790.      BEGIN
  791.           SinTab[I]:=Round(128*Sin(I/64*Pi));
  792.           CosTab[I]:=Round(128*Cos(I/64*Pi));
  793.      END;
  794.      FOR J:=0 TO 7 DO
  795.          FOR I:=0 TO 15 DO
  796.          BEGIN
  797.               IF (I AND 1=1) XOR (J AND 1=1) THEN
  798.                  R:=63
  799.               ELSE R:=0;
  800.               IF (I AND 2=2) XOR (J AND 2=2) THEN
  801.                  G:=63
  802.               ELSE G:=0;
  803.               IF (I AND 4=4) XOR (J AND 4=4) THEN
  804.                  B:=63
  805.               ELSE B:=0;
  806.               SetColor(J SHL 4+I,R,G,B);
  807.          END;
  808.      FOR I:=0 TO 15 DO
  809.          SetColor(128+I,0,0,0);
  810.      StartMap:=0;
  811.      EndMap:=1;
  812.      SetOffset(0);
  813.      FOR I:=0 TO 2 DO
  814.      BEGIN
  815.           SizeX[I]:=1;
  816.           DirX[I]:=1;
  817.           IF SizeX[I]>127 THEN
  818.           BEGIN
  819.                SizeX[I]:=255-SizeX[I];
  820.                DirX[I]:=-1;
  821.           END;
  822.           PhaseX[I]:=32*I;
  823.      END;
  824.      Phase:=0;
  825.      REPEAT
  826.            CLI;
  827.            PalSel:=0;
  828.            FOR I:=StartMap TO EndMap-1 DO
  829.                YCount[I]:=SinTab[PhaseX[I]]-200;
  830.            FOR I:=StartMap TO EndMap-1 DO
  831.            BEGIN
  832.                 WHILE YCount[I]>SizeX[I] SHL 2 DO
  833.                       Dec(YCount[I],SizeX[I] SHL 2);
  834.                 WHILE YCount[I]<0 DO
  835.                       Inc(YCount[I],SizeX[I] SHL 2);
  836.                 IF YCount[I]>SizeX[I] SHL 1 THEN
  837.                 BEGIN
  838.                      Dec(YCount[I],SizeX[I] SHL 1);
  839.                      PalSel:=PalSel XOR (1 SHL I);
  840.                 END;
  841.            END;
  842.            WaitScreen;
  843.            FOR J:=0 TO 359 DO
  844.            BEGIN
  845.                 ASM
  846.                    mov bx,offset ycount
  847.                    mov si,offset sizex
  848.                    cld
  849.                    lodsw
  850.                    shl ax,1
  851.                    mov dx,[bx]
  852.                    cmp startmap,0
  853.                    jg @1a
  854.                    cmp ax,dx
  855.                    jnz @1
  856.                    xor byte ptr palsel,1
  857.                    mov word ptr [bx],0
  858. @1:                inc word ptr [bx]
  859.                    cmp endmap,1
  860.                    jz @4
  861.  
  862. @1a:               add bx,2
  863.  
  864.                    lodsw
  865.                    shl ax,1
  866.                    mov dx,[bx]
  867.                    cmp startmap,1
  868.                    jg @2a
  869.                    cmp ax,dx
  870.                    jnz @2
  871.                    xor byte ptr palsel,2
  872.                    mov word ptr [bx],0
  873. @2:                inc word ptr [bx]
  874.                    cmp endmap,2
  875.                    jz @4
  876.  
  877. @2a:               add bx,2
  878.  
  879.                    lodsw
  880.                    shl ax,1
  881.                    mov dx,[bx]
  882.                    cmp ax,dx
  883.                    jnz @3
  884.                    xor byte ptr palsel,4
  885.                    mov word ptr [bx],0
  886. @3:                inc word ptr [bx]
  887.                    add bx,2
  888. @4:
  889.                 END;
  890.                 ASM
  891.                    mov dx,03c0h
  892.                    mov al,34h
  893.                    out dx,al
  894.                    mov al,palsel
  895.                    out dx,al
  896.  
  897.                    mov dx,03dah
  898. @1:                in al,dx
  899.                    test al,1
  900.                    jnz @1
  901. @2:                in al,dx
  902.                    test al,1
  903.                    jz @2
  904.                 END;
  905.            END;
  906.            Set16Pal(8);
  907.            WaitRetrace;
  908.            FOR I:=StartMap TO EndMap-1 DO
  909.            BEGIN
  910.                 Inc(SizeX[I],DirX[I]);
  911.                 IF (SizeX[I]=16) AND (DirX[I]=-1) OR (SizeX[I]=127) THEN
  912.                    DirX[I]:=-DirX[I];
  913.            END;
  914.            FOR I:=StartMap TO EndMap-1 DO
  915.            BEGIN
  916.                 ASM
  917.                    mov cx,i
  918.                    mov ah,1
  919.                    shl ah,cl
  920.                    mov al,2
  921.                    mov dx,03c4h
  922.                    out dx,ax
  923.                 END;
  924.                 XCountCurr:=CosTab[PhaseX[I]]-160;
  925.                 ASM
  926.                    mov si,i
  927.                    shl si,1
  928.                    add si,offset sizex
  929.                    lodsw
  930.                    shl ax,1
  931.                    mov bx,xcountcurr
  932. @1:                cmp bx,ax
  933.                    jle @2
  934.                    sub bx,ax
  935.                    jmp @1
  936. @2:                or bx,bx
  937.                    jge @3
  938.                    add bx,ax
  939.                    jmp @2
  940. @3:                xor dx,dx
  941.                    shr ax,1
  942.                    cmp bx,ax
  943.                    jle @4
  944.                    sub bx,ax
  945.                    inc dx
  946. @4:                mov si,ax
  947.                 END;
  948.                 ASM
  949.                    mov ax,0a000h
  950.                    mov es,ax
  951.                    xor di,di
  952.                    mov dh,20
  953.                    cld
  954. @0:                xor ax,ax
  955.                    mov cx,16
  956. @1:                shl ax,1
  957.                    or al,dl
  958.                    cmp bx,si
  959.                    jnz @2
  960.                    xor bx,bx
  961.                    xor dl,1
  962. @2:                inc bx
  963.                    loop @1
  964.                    xchg al,ah
  965.                    stosw
  966.                    dec dh
  967.                    jnz @0
  968.                 END;
  969.            END;
  970.            FOR I:=EndMap TO 2 DO
  971.            BEGIN
  972.                 SetWriteMap(1 SHL I);
  973.                 ASM
  974.                    mov ax,0a000h
  975.                    mov es,ax
  976.                    xor di,di
  977.                    mov cx,10
  978.                    db 66h
  979.                    xor ax,ax
  980.                    cld
  981.                    db 66h
  982.                    rep stosw
  983.                 END;
  984.            END;
  985.            FOR I:=0 TO StartMap-1 DO
  986.            BEGIN
  987.                 SetWriteMap(1 SHL I);
  988.                 ASM
  989.                    mov ax,0a000h
  990.                    mov es,ax
  991.                    xor di,di
  992.                    mov cx,10
  993.                    db 66h
  994.                    xor ax,ax
  995.                    cld
  996.                    db 66h
  997.                    rep stosw
  998.                 END;
  999.            END;
  1000.            FOR I:=0 TO 2 DO
  1001.            BEGIN
  1002.                 IF PhaseX[I]=128 THEN
  1003.                    PhaseX[I]:=0
  1004.                 ELSE Inc(PhaseX[I]);
  1005.            END;
  1006.            Inc(Phase);
  1007.            IF Phase=512 THEN
  1008.               EndMap:=2
  1009.            ELSE
  1010.            IF Phase=1024 THEN
  1011.               EndMap:=3
  1012.            ELSE
  1013.            IF Phase=2048 THEN
  1014.               StartMap:=1
  1015.            ELSE
  1016.            IF Phase=2560 THEN
  1017.               StartMap:=2;
  1018.            STI;
  1019.      UNTIL KeyPressed OR (Phase=3072);
  1020.      IF KeyPressed THEN
  1021.         WaitKey;
  1022.  
  1023.      { Screen wobbler }
  1024.  
  1025.      Init13X;
  1026.      Port[$3D4]:=9;
  1027.      Port[$3D5]:=Port[$3D5] AND $F0;
  1028.      CalcOfsTable;
  1029.      LoadSprite('KEWLAARD',Spr);
  1030.      LoadPalette('KEWLAARD');
  1031.      SetColor(0,0,0,0);
  1032.      FOR I:=0 TO 255 DO
  1033.          GetColor(I,Pal[I,1],Pal[I,2],Pal[I,3]);
  1034.      FOR I:=0 TO 3 DO
  1035.      BEGIN
  1036.           SetWriteMap(1 SHL I);
  1037.           ASM
  1038.              push ds
  1039.              mov ax,0a000h
  1040.              mov es,ax
  1041.              mov ax,i
  1042.              lds si,spr
  1043.              add si,ax
  1044.              add si,4
  1045.              mov dx,198
  1046.              cld
  1047. @1:          mov di,050h
  1048.              mov cx,80
  1049. @2:          movsb
  1050.              add si,3
  1051.              loop @2
  1052.              sub si,320
  1053.              mov cx,80
  1054. @3:          movsb
  1055.              add si,3
  1056.              loop @3
  1057.              mov ax,es
  1058.              add ax,0ah
  1059.              mov es,ax
  1060.              dec dx
  1061.              jnz @1
  1062.              pop ds
  1063.           END;
  1064.      END;
  1065.      FOR I:=0 TO 3 DO
  1066.      BEGIN
  1067.           SetWriteMap(1 SHL I);
  1068.           ASM
  1069.              push ds
  1070.              mov ax,0afb7h
  1071.              mov es,ax
  1072.              mov ax,i
  1073.              lds si,spr
  1074.              add si,ax
  1075.              add si,4
  1076.              mov dx,198
  1077.              cld
  1078. @1:          mov di,050h
  1079.              mov cx,80
  1080. @2:          movsb
  1081.              add si,3
  1082.              loop @2
  1083.              sub si,320
  1084.              mov cx,80
  1085. @3:          movsb
  1086.              add si,3
  1087.              loop @3
  1088.              mov ax,es
  1089.              sub ax,0ah
  1090.              mov es,ax
  1091.              dec dx
  1092.              jnz @1
  1093.              pop ds
  1094.           END;
  1095.      END;
  1096.      Port[$3D4]:=$11;
  1097.      Port[$3D5]:=Port[$3D5] AND $7F;
  1098.      FOR I:=0 TO 799 DO
  1099.          DisplayStart[I]:=Round(20*Sin(I/50*Pi));
  1100.      Phase:=0;
  1101.      K:=0;
  1102.      REPEAT
  1103.            CLI;
  1104.            VerticalRetrace;
  1105.            J:=(Phase MOD 200) SHL 1;
  1106.            IF Phase<63 THEN
  1107.               Inc(K)
  1108.            ELSE
  1109.            IF Phase>960 THEN
  1110.               Dec(K);
  1111.            ASM
  1112.               mov si,offset displaystart
  1113.               add si,j
  1114.               mov cx,280
  1115.               cld
  1116. @0:           lodsb
  1117.               cbw
  1118.               mov bx,k
  1119.               imul bx
  1120.               add ah,86
  1121.               mov dx,03dah
  1122. @1:           in al,dx
  1123.               test al,1
  1124.               jnz @1
  1125.               mov dx,03d4h
  1126.               mov al,4
  1127.               out dx,ax
  1128.               mov dx,03dah
  1129. @2:           in al,dx
  1130.               test al,1
  1131.               jz @2
  1132.               loop @0
  1133.            END;
  1134.            Inc(Phase);
  1135.            STI;
  1136.      UNTIL (Phase=512) OR KeyPressed;
  1137.      IF KeyPressed THEN
  1138.         WaitKey;
  1139.  
  1140.      { Screen rotate off }
  1141.  
  1142.      I:=199;
  1143.      Dir:=-1;
  1144.      Adr:=0;
  1145.      Phase:=0;
  1146.      REPEAT
  1147.            CLI;
  1148.            IF I>=34 THEN
  1149.               ShowPicture
  1150.            ELSE
  1151.            IF (I=33) AND (Dir=-1) THEN
  1152.            BEGIN
  1153.                 Adr:=$8000-Adr;
  1154.                 SetStart(Adr);
  1155.            END
  1156.            ELSE VerticalRetrace;
  1157.            Inc(I,Dir);
  1158.            IF (I=1) OR (I=199) THEN
  1159.               Dir:=-Dir;
  1160.            Inc(Phase);
  1161.            STI;
  1162.      UNTIL (Phase=970) OR KeyPressed;
  1163.      IF KeyPressed THEN
  1164.         WaitKey;
  1165.  
  1166. { Roundscroller with Greetings }
  1167.  
  1168.      LastCos:=Round(200*Sqrt(Cos(Pi/2)));
  1169.      FOR I:=139 DOWNTO 0 DO
  1170.      BEGIN
  1171.           CurrCos:=Round(140*Sqrt(Cos(I/280*Pi)));
  1172.           GapTab[139-I]:=CurrCos-LastCos+1;
  1173.           IF GapTab[139-I]>7 THEN
  1174.              GapTab[139-I]:=224
  1175.           ELSE GapTab[139-I]:=GapTab[139-I] SHL 5;
  1176.           GapTab[260+I]:=GapTab[139-I];
  1177.           LastCos:=CurrCos;
  1178.      END;
  1179.      FOR I:=0 TO 199 DO
  1180.      BEGIN
  1181.           ColorTab[I]:=Round(63*Sin((I+56)/512*Pi));
  1182.           ColorTab[399-I]:=ColorTab[I];
  1183.      END;
  1184.      FOR I:=140 TO 259 DO
  1185.          GapTab[I]:=32;
  1186.      FOR I:=0 TO 1023 DO
  1187.          TextData[I SHR 4,I AND 15]:=TextStr[1+I MOD Length(TextStr)];
  1188.      MCGAOn;
  1189.      SetModeReg('256X400');
  1190.      Unchain;
  1191.      ClearScreen;
  1192.      FOR I:=0 TO 15 DO
  1193.          SetColor(I,31,I SHL 2,I SHL 2);
  1194.      LoadFontMCF('CLEAN16');
  1195.      Phase:=0;
  1196.      K:=0;
  1197.      VerticalRetrace;
  1198.      REPEAT
  1199.            CLI;
  1200.            ASM
  1201.               mov bx,phase
  1202.               shl bx,7
  1203.               mov dx,03d4h
  1204.               mov al,0ch
  1205.               mov ah,bh
  1206.               out dx,ax
  1207.               inc ax
  1208.               mov ah,bl
  1209.               out dx,ax
  1210.  
  1211.               mov dx,03dah
  1212. @2:           in al,dx
  1213.               test al,8
  1214.               jnz @2
  1215.            END;
  1216.            ASM
  1217.               mov cx,400
  1218.               xor si,si
  1219.               cld
  1220.  
  1221. @0:           mov dx,03c8h
  1222.               mov al,0
  1223.               out dx,al
  1224.               inc dx
  1225.               push si
  1226.               add si,offset colortab
  1227.               lodsb
  1228.               mul byte ptr k
  1229.               mov al,ah
  1230.               out dx,al
  1231.               mov al,0
  1232.               out dx,al
  1233.               out dx,al
  1234.  
  1235.               mov dx,03dah
  1236. @1:           in al,dx
  1237.               test al,1
  1238.               jnz @1
  1239.  
  1240.               mov dx,03d4h
  1241.               mov al,13h
  1242.               pop si
  1243.               push si
  1244.               add si,offset gaptab
  1245.               mov ah,[si]
  1246.               out dx,ax
  1247.  
  1248.               mov dx,03dah
  1249. @2:           in al,dx
  1250.               test al,1
  1251.               jz @2
  1252.  
  1253.               pop si
  1254.               inc si
  1255.               loop @0
  1256.            END;
  1257.            FOR I:=0 TO 15 DO
  1258.                ASM
  1259.                   cld
  1260.                   push ds
  1261.                   pop es
  1262.                   mov di,offset linedata
  1263.                   mov bx,i
  1264.                   shl bx,2
  1265.                   mov si,phase
  1266.                   push si
  1267.                   shr si,4
  1268.                   and si,63
  1269.                   shl si,4
  1270.                   add si,i
  1271.                   add si,offset textdata
  1272.                   lodsb
  1273.                   mov ah,0
  1274.                   shl ax,2
  1275.                   mov si,offset fontch
  1276.                   add si,ax
  1277.                   lds si,[si]
  1278.                   pop si
  1279.                   and si,15
  1280.                   shl si,4
  1281.                   add si,4
  1282.                   mov cx,16
  1283. @1:               lodsb
  1284.                   mov es:[di+bx],al
  1285.                   add bl,64
  1286.                   adc bl,0
  1287.                   loop @1
  1288.                   push es
  1289.                   pop ds
  1290.                END;
  1291.            FOR I:=0 TO 1 DO
  1292.                ASM
  1293.                   mov ax,0a000h
  1294.                   mov es,ax
  1295.                   mov di,phase
  1296.                   shl di,1
  1297.                   add di,i
  1298.                   shl di,6
  1299.                   add di,0c000h
  1300.                   mov bx,di
  1301.                   mov si,offset linedata
  1302.                   mov dx,03c4h
  1303.                   cld
  1304.                   mov ax,0102h
  1305.                   out dx,ax
  1306.                   mov cx,16
  1307.                   db 66h
  1308.                   rep movsw
  1309.                   mov ax,0202h
  1310.                   out dx,ax
  1311.                   mov cx,16
  1312.                   mov di,bx
  1313.                   db 66h
  1314.                   rep movsw
  1315.                   mov ax,0402h
  1316.                   out dx,ax
  1317.                   mov cx,16
  1318.                   mov di,bx
  1319.                   db 66h
  1320.                   rep movsw
  1321.                   mov ax,0802h
  1322.                   out dx,ax
  1323.                   mov cx,16
  1324.                   mov di,bx
  1325.                   db 66h
  1326.                   rep movsw
  1327.                END;
  1328.            Inc(Phase);
  1329.            IF Phase<255 THEN
  1330.               Inc(K)
  1331.            ELSE
  1332.            IF Phase>1024-256 THEN
  1333.               Dec(K);
  1334.            STI;
  1335.      UNTIL (Phase=1024) OR KeyPressed;
  1336.      IF KeyPressed THEN
  1337.         WaitKey;
  1338.      SetModeNr(3);
  1339. END.